Shareware Grab Bag/Shareware Grab Bag.iso/001/wardial.arc/WARDIAL.PAS

Pascal/Delphi Source File | 1986-04-30 | 37KB | 1,418 lines

{ ****************************************************************************
  *                                                                          *
  *                        Wardial 1.2 By Jim Everingham                     *
  *                        ------------------------------                    *
  *     This Program is released to public domain by Jim Everingham. It      *
  *     May be distributed and modified at will.  This program utilizes      *
  *     the commcall routines by Allen Bishop.  I have not cleaned up        *
  *     this source code, so it may seem a bit messy.  It can be shortened   *
  *     substantially if given a little time. Any questions can be sent      *
  *     to:                                                                  *
  *                            Jim Everingham                                *
  *                            215 West Fairmount Ave                        *
  *                            Apt 306 Fairmount Hills                       *
  *                            State College, Pa 16801                       *
  *                                                                          *
  ****************************************************************************  }









{$C-}
Procedure wardial;forward;
Procedure menu;forward;
Procedure Set_modem_parameters;forward;
Procedure beep; forward;

const
   Windows    = 5;
   Wtab       : array[1..Windows,1..5] of Integer
                = (( 5,  2,  75, 10,  1),
                   ( 5,  14,  33, 23,  1),
                   ( 46, 14,  75, 23,  1),
                   ( 5,  23,  75, 24, 1),
                   ( 1,  1,   80, 21, 1)
                  );
   recv_buf_size = 4096;   {Recieve buffer size, can be changed}

type buffer_pointer   = integer;
     smallstring      = string[2];
     bigstring        = string[255];
     storage          = byte;
     check_bit        = (none,even);
     sd = string[40];
     st = string[8];
     string255=string[255];

var leave                 : boolean;  {end of routine marker}
    buf_start, buf_end    : buffer_pointer;
    stop_time             : sd;
    recv_buffer           : array [1..recv_buf_size] of storage;
    speed                 : integer;
    Service_number, Num, Checksum_number,code: sd;
    dbits                 : integer;
    stop_bits             : integer;
    parity                : check_bit;
    code_found            : array[1..20] of sd;
    zz,code_length        : integer;
    ch                    : char;
    ii                    : integer;
    Xon,Xoff              : char;
    screen1               : Array[1..4000] of byte absolute $B800:$0000;
    screen2               : Array[1..4000] of byte;
    Xcoord,ycoord,x2,y2   : Integer;
    Dial_Speed,Dial_type,Speaker,Duplex,Command_echo,Response_time:sd;
    maincolor             : integer;
    Print_stat            : boolean;
    Printer               : boolean;
    Dial_command,Pause_command,Start_num:string[20];

Procedure init_screen;
begin
lowvideo;
window(1,1,80,25);
clrscr;
end;


function time2 : st;
type
  registors = record
              ax,bx,cx,dx,bp,si,ds,es,flags: integer;
              end;
var
  regisrec               : registors;
  hour , minute , second : string[2];
  cx , dx                : integer;
begin
  with regisrec do
  begin
    ax := $2C shl 8;
  end;
  msdos(regisrec);
  with regisrec do
  begin
    str(cx shr 8 , hour);
    str(cx mod 256 , minute);
    str(dx shr 8 , second);
  end;
  if length(hour  ) = 1 then insert('0',hour  ,1);
  if length(minute) = 1 then insert('0',minute,1);
  if length(second) = 1 then insert('0',second,1);
  time2:= hour + ':' + minute + ':' + second
end;



function time : st;
type
  registors = record
              ax,bx,cx,dx,bp,si,ds,es,flags: integer;
              end;
var
  regisrec               : registors;
  hour , minute , second : string[2];
  cx , dx                : integer;
begin
  with regisrec do
  begin
    ax := $2C shl 8;
  end;
  msdos(regisrec);
  with regisrec do
  begin
    str(cx shr 8 , hour);
    str(cx mod 256 , minute);
    str(dx shr 8 , second);
  end;
  if length(hour  ) = 1 then insert(' ',hour  ,1);
  if length(minute) = 1 then insert('0',minute,1);
  if length(second) = 1 then insert('0',second,1);
  time := minute + second
end;



procedure check_range(var range : integer);
begin
 if range > recv_buf_size then range := 1;
end;

function commpressed : boolean;
begin
 commpressed := (buf_start <> buf_end);
end;

function cinkey : smallstring;
var result : smallstring;
    temp   : integer;
begin
 if not commpressed then result := ''
 else
 begin
  inline ($FA);  {very important}
  temp := recv_buffer[buf_start];
  buf_start := buf_start +1;
  check_range(buf_start);
  inline ($FB);  {very important}
  result := chr(temp);
 end;
 cinkey := result;
end;


function carrier : boolean;
begin
 carrier := odd(port[$3FE] shr 7);
end;

procedure set_up_recv_buffer;
begin
 buf_start := 1;
 buf_end   := 1;
end;

procedure set_baud(rate : integer);
var a : byte;
    divided : real;
begin
 if rate<=9600 then
 begin
  speed := rate;
  divided := 115200.0/rate;
  rate := trunc(divided);
  a := port[$3fb];
  if a < 128 then a := a+128;
  port[$3fb] := a;
  port[$3f8] := lo(rate);
  port[$3f9] := hi(rate);
  port[$3fb] := a-128;
 end;
end;

procedure update_uart;
var a : byte;
begin
 a := dbits-5;
 if stop_bits = 2 then a := a + 4;
 if parity = even then a := a + 24;
 port[$3fb] := a;
end;


procedure init_port;
var a,b : integer;
    buf_len : integer;
begin
 update_uart;
 port[$3f9] := 1;             {interupt enable}
 a := port[$3fc];
 if odd(a) then a := 1 else a := 0;   {keep terminal ready}
 a := a+10;
 port[$3fc] := a;                     {turn on req to send and out2}
 a := port[$3fa];
 port[$21]  := $c;
 set_baud(speed);
 buf_len := recv_buf_size;

 {this is the background routine}

 inline (
  $1E/
  $0E/
  $1F/
  $BA/*+23/
  $B8/$0C/$25/
  $CD/$21/
  $8B/$BE/BUF_LEN/
  $89/$3E/*+87/
  $1F/
  $2E/$8C/$1E/*+83/
  $EB/$51/
  $FB/
  $1E/
  $50/
  $53/
  $52/
  $56/
  $2E/$8E/$1E/*+70/
  $BA/$F8/$03/
  $EC/
  $BE/RECV_BUFFER/
  $8B/$1E/BUF_END/
  $88/$40/$FF/
  $43/
  $E8/$22/$00/
  $89/$1E/BUF_END/
  $3B/$1E/BUF_START/
  $75/$0C/
  $8B/$1E/BUF_START/
  $43/
  $E8/$10/$00/
  $89/$1E/BUF_START/
  $BA/$20/$00/
  $B0/$20/
  $EE/
  $5E/
  $5A/
  $5B/
  $58/
  $1F/
  $CF/
  $2E/$8B/$16/*+11/
  $42/
  $39/$DA/
  $75/$03/
  $BB/$01/$00/
  $C3/
  $00/$00/
  $00/$01/
  $90
 );
end;

procedure term_ready(state : boolean);
var a : byte;
begin
 a := port[$3fc];
 if odd(a) then a := a - 1;
 a := a + ord(state);
 port[$3fc] := a;
end;

procedure remove_port;
var a : byte;
begin
 port[$3f9] := 0;
 a := port[$3fc];
 if odd(a) then a := 1 else a := 0;
 port[$3fc] := a;
 port[$21]  := $BC;
end;

procedure write_byte(to_send : bigstring);
var a,b,c : byte;
begin
 for b := 1 to length(to_send) do
 begin
  c := ord(to_send[b]);
  repeat a := port[$3fd];
  until odd(a shr 5);
  port[$3f8] := c;
 end;
end;

   procedure Frame(UpperLeftX, UpperLeftY, LowerRightX, LowerRightY: Integer);
   var
      i: Integer;
   begin
      GotoXY(UpperLeftX, UpperLeftY);  Write(chr(201));
      for i:=UpperLeftX+1 to LowerRightX-1 do Write(chr(205));
      Write(chr(187));
      for i:=UpperLeftY+1 to LowerRightY-1 do
      begin
         GotoXY(UpperLeftX , i);  Write(chr(186));
         GotoXY(LowerRightX, i);  Write(chr(186));
      end;
      GotoXY(UpperLeftX, LowerRightY);
      Write(chr(200));
      for i:=UpperLeftX+1 to LowerRightX-1 do Write(chr(205));
      Write(chr(188));
   end  { Frame };

{$I Send_asc.pas}
{$I Rcv_asc.pas}

procedure break;
var a,b : byte;
begin
 a := port[$3fb];
 b := a;
 if b > 127 then b := b - 128;
 if b <= 63 then b := b + 64;
 port[$3fb] := b;
 delay(400);
 port[$3fb] := a;
end;

procedure setup;
var a : byte;
begin
 dbits        := 8;
 parity       := none;
 stop_bits    := 1;
 speed        := 1200;
 init_port;
 term_ready(true);
end;

Procedure Help_wardial;
var a:char;
begin
     write_byte(chr(13));
     xcoord:=wherex;
     ycoord:=wherey;
     move(screen1,screen2,4000);
     normvideo;
     lowvideo;
     window(1,1,80,25);
     normvideo;
     textcolor(12);
     frame(24,9,56,21);
     lowvideo;
     window(25,10,55,20);
     textcolor(15);
     clrscr;
     gotoxy(10,1);
     writeln('Help Menu');
     gotoxy(1,3);
     textcolor(7);
     writeln('  <Alt-P>  Toggle Printer ');
     writeln('  <Alt-M>  Set Modem Params');
     writeln('  <Alt-X>  Exit to Menu');
     gotoxy(1,10);
     textcolor(white+blink);
     writeln('        Hit any Key');
     repeat until keypressed;
     normvideo;
     lowvideo;
     window(1,1,80,25);
     normvideo;
     textcolor(12);
     move(screen2,screen1,4000);
     window(5,14,33,23);
     gotoxy(xcoord,ycoord);
end;



Procedure beep;
begin
     sound(2000);
     delay(100);
     nosound;
end;


   procedure SelectWindow(Win: Integer);
   begin
      Window(Wtab[Win,1], Wtab[Win,2], Wtab[Win,3], Wtab[Win,4])
   end  { SelectWindow };

Procedure Toggle_printer;
var b,temp:sd;
begin
beep;
if Print_stat then
     begin
           Print_stat:=false;
           write(lst,chr(12));
     end
else
    begin
         b:=num;
         write(lst,'WARDIAL 1.2':25,'SEARCHING:':30);
         if copy(b,1,1)='1' then temp:=copy(b,1,1)+'-'
         else temp:=copy(b,5,3)+'-';
         if copy(b,2,3)='800' then temp:=temp+'800-'+copy(b,5,3)+'-'+copy(b,8,4)
         else temp:=num;
         write(lst,temp);
         writeln(lst);
         Print_stat:=true;
         writeln(lst);
         writeln(lst,'Code Number':12,'Code':12);
         writeln(lst);
    end;
end;

Procedure Toggle3_printer;
var b,temp:sd;
begin
beep;
if Print_stat then
     begin
           Print_stat:=false;
           write(lst,chr(12));
     end
else
    begin
         writeln(lst,'WARDIAL 1.2':25,'SEARCHING FOR CARRIERS':30);
         writeln(lst);
         Print_stat:=true;
         writeln(lst);
         writeln(lst,'Carriers at':10);
         writeln(lst);
    end;
end;

Procedure All_codes;
var k:integer;
begin
if zz>0 then
      begin
           Normvideo;
           lowvideo;
           window(1,1,80,25);
           normvideo;
           textcolor(12);
           Frame(9,3,21,20);
           lowvideo;
           textcolor(7);
           window(10,4,20,19);
           ClrScr;
           gotoxy(1,15);
           textcolor(7);
           for k:=1 to zz do
               begin
                    writeln(code_found[k]:8);
                    if k=13 then
                             begin
                                  textcolor(white+blink);
                                  write(' Hit a Key');
                                  repeat until keypressed;
                                  textcolor(7);
                             end;
                    insline;
               end;
         textcolor(white+blink);
         write(' Hit a Key');
         repeat until keypressed;
    end;
end;


Procedure test_carrier(var test:boolean; code:sd; timing_constant:integer);
var i,j,k,result: integer;
              cr: char;
begin
     val(time,i,result);
     j:=i+timing_constant;
     while (j>i) do
           begin
           val(time,i,result);
           if carrier then
              begin
              zz:=zz+1;
              code_found[zz]:=code;
              textcolor(white+blink);
              write('Code Found!');
              sound(1000);
              delay(500);
              nosound;
              if Print_stat then  writeln(lst,zz:6,code:20);
              write_byte('+++');
              delay (3000);
              Write_byte('ATH0');
              j:=i-26;
              end;
           if keypressed then
              begin
                   read(kbd,cr);
                   if cr=chr(25) then toggle_printer else
                   if cr=chr(35) then Help_wardial else
                   if cr=chr(50) then begin
                                           set_modem_parameters;
                                           gotoxy(xcoord,ycoord);
                                           end
                                      else
                   if cr=chr(45) then
                      begin
                         j:=i-26;
                         test:=true;
                         All_codes;
                         end;
                      end;
           end;
write_byte('-');
write_byte(chr(13));
for i:=1 to maxint do ;;
end;

Procedure Send_code(service_number,code,checksum_number:sd);
var i,j: integer;
outword:sd;
begin
outword:=service_number+code+checksum_number+chr(13);
Lowvideo;
selectwindow(2);
gotoxy(1,1);
insline;
textcolor(12);
write('   TRYING: ',code);
normvideo;
write_byte(outword);
end;

Procedure write_codes;
var i:integer;
begin
lowvideo;
selectwindow(3);
gotoxy(1,1);
CLrScr;
textcolor(12);
if zz=0 then writeln('   NO CODES')
else for i:=1 to zz do writeln('  CODE AT: ',code_found[i]);
normvideo;
end;


Procedure Get_code(var code:sd);
var i,j: integer;
a,b: sd;
begin
     repeat
           i:=random(999)
     until i > 100;
     str(i,a);
     if code_length > 5 then
              begin
                   i:=random(9);
                   str(i,b);
                   a:=a+b;
              end;
     if code_length > 6 then
              begin
                   i:=random(9);
                   str(i,b);
                   a:=a+b;
              end;

     if code_length > 7 then
              begin
                   i:=random(9);
                   str(i,b);
                   a:=a+b;
              end;
     i:=random(9);
     str(i,b);
     code:=Start_num+a+b;
end;

Procedure help;
begin
xcoord:=whereX;
ycoord:=wherey;
move (screen1,screen2,4000);
textcolor(lightblue);
frame(45,1,75,16);
lowvideo;
window(46,2,74,15);
textcolor(15);
clrscr;
gotoxy(1,1);
writeln('        Help Menu');
textcolor(7);writeln;
writeln(' <Alt-Y>  Displays menu');
writeln(' <Alt-P>  To set Parameters');
writeln(' <Alt-E>  To Toggle Echo');
writeln(' <Alt-Q>  Returns to menu');
Writeln(' <Alt-O>  Hangs up Modem');
writeln(' <Alt-A>  Modem Parameters');
writeln(' <Alt-S>  Send Ascii File');
writeln(' <Alt-R>  Recieve file Ascii');
writeln(' <Alt-W>  Dial Number ');
gotoxy(1,14);
textcolor(white+blink);
write('      Press Any Key');
repeat until keypressed;
normvideo;
lowvideo;
selectwindow(5);
textcolor(lightcyan);
move(screen2,screen1,4000);
gotoxy(xcoord,ycoord);
end;


Procedure Set_parameters;
var temp: sd;
result:integer;
begin
xcoord:=whereX;
ycoord:=whereY;
move (screen1,screen2, 4000);
textcolor(lightblue);
frame(10,5,65,15);
lowvideo;
window(11,6,64,14);
writeln;
normvideo;
clrscr;
gotoxy(1,2);
if parity=even then temp:='Even' else temp:='None';
textcolor(7);
writeln('   Current Parameters: ',Speed:4,'-',Stop_bits:2,'-',temp:5,'-',Dbits:2 );writeln;
write('   Enter Baud      : ');readln(temp);
if length(temp)>1 then val(temp,speed,result);
write('   Enter Stop bits : ');readln(temp);
if length(temp)>0 then val(temp,stop_bits,result);
write('   Parity <E>ven <N>one : ');readln(temp);
if length(temp) >0 then if (copy(temp,1,1)='E') or (copy(temp,1,1)='e') then parity:=even
else parity:=none;
write('   Enter Data bits : ');readln(temp);
if length(temp)>0 then val(temp,dbits,result);
init_port;
textcolor(lightcyan);
lowvideo;
selectwindow(5);
move (screen2,screen1, 4000);
gotoxy(Xcoord,Ycoord);
end;

Procedure Set_Modem_Parameters;
var temp:sd;
begin
write_byte(chr(13));
xcoord:=wherex;
ycoord:=wherey;
move (screen1,screen2,4000);
NormVideo;
lowvideo;
window(1,1,80,25);
Normvideo;
Textcolor(12);
frame(38,1,73,13);
LowVideo;
window(39,2,72,12);
Clrscr;
gotoxy(1,1);
textcolor(white);
writeln('         Modem Parameters');
gotoxy(1,4);
textcolor(7);
Writeln('      Dial Speed     ',Dial_speed:3,': ');
Writeln('      <P>ulse <T>one ',Dial_type:3,': ');
if Speaker='M0' then temp:='OFF' else temp:='ON';
writeln('      Speaker        ',Temp:3,': ');
if Duplex='F0' then temp:='HALF' else Temp:='FULL';
writeln('      Duplex is     ',temp:4,': ');
if Command_echo='E0' then temp:='OFF' else temp:='ON';
writeln('      Command Echo   ',temp:3,': ');
writeln('      Response Time  ',Response_time:3,': ');
gotoxy(1,10);
textcolor(white+blink);
write('           Enter Values');
textcolor(7);
gotoxy(27,4);readln(temp);
if length(temp) > 1 then Dial_speed:=temp;
gotoxy(27,4);readln(temp);
if length(temp) > 0 then dial_type:=upcase(copy(temp,1,1));
gotoxy(27,5);readln(temp);
if length(temp) > 0 then if (temp='Off') or (temp='off') or (temp='OFF') then Speaker:='M0';
gotoxy(27,6);readln(temp);
if length(temp) > 0 then if Upcase(copy(temp,1,1))='H' then Duplex:='F0';
gotoxy(27,7);readln(temp);
if length(temp) > 0 then if (temp='Off') or (temp='off') or (temp='OFF') then Command_echo:='E0';
gotoxy(27,8);readln(temp);
if length(temp) > 0 then response_time:=temp;
gotoxy(1,10);textcolor(lightcyan+blink);
write('      Please Wait: Working');
if carrier then write_byte('+++');
delay(2000);
temp:='ATS11='+dial_speed+chr(13);write_byte(temp);delay(1000);
temp:='AT'+Speaker+chr(13);write_byte(temp);delay(1000);
temp:='AT'+Duplex+chr(13);write_byte(temp);delay(1000);
temp:='AT'+Command_echo+chr(13);write_byte(temp);delay(1000);
temp:='ATS9='+response_time+chr(13);write_byte(temp);delay(1000);
if carrier then write_byte('ATA');write_byte(chr(13));beep;beep;
normvideo;
lowvideo;
window(1,1,80,25);
move(screen2,screen1,4000);
textcolor(maincolor);
end;




Procedure Hang_up;
var i,j:integer;
begin
Sound(500);
delay(100);
nosound;
write_byte('+++');
delay (3000);
Write_byte('ATH0');
Write_byte(chr(13));
sound(500);
delay(100);
nosound;
Delay(200);
sound(500);
delay(100);
nosound;
end;


Procedure Sequential_dial;
var prefix,temp,start_pos,end_pos,t2:sd;
    a,b,c,i,j,k,timing_Constant:integer;
    dial_stop:boolean;
    ab:char;
begin
      NormVideo;
      Lowvideo;
      window(1,1,80,25);
      normvideo;
      clrscr;
      textcolor(12);
      frame(5,2,75,6);
      textcolor(11);
      frame(5,8,75,21);
      gotoxy(7,4);
      textcolor(15);
      Write('                  Wardial 1.2       Sequential dialer');
      lowvideo;
      window(6,9,73,19);
      gotoxy(1,3);
      textcolor(12);
      Writeln('  Set Paramters');
      textcolor(cyan);
      writeln;
      write('  Enter Prefix to dial : ');
      textcolor(11);
      readln(prefix);
      textcolor(cyan);
      write('  Starting At (XXXX)   : ');
      textcolor(11);
      readln(Start_pos);
      zz:=0;
      textcolor(cyan);
      write('  Ending At   (XXXX)   : ');
      textcolor(11);
      readln(End_pos);
      textcolor(cyan);
      write('  Timing Constant      : ');
      textcolor(11);
      readln(temp);
      if length(temp)>0 then val(temp,timing_constant,i) else timing_constant:=14;
      writeln;
      textcolor(7);
      write('  <');textcolor(white);write('Alt-H');textcolor(7);write('> For Help Menu');
      val(start_pos,a,i);
      val(end_pos,b,i);
      dial_stop:=false;
      gotoxy(48,3);
      textcolor(11);
      zz:=0;
      write(' Status');
      repeat
            temp:='';
            start_pos:='';
            if a<9 then temp:='000';
            if (a<99) and (a>9) then temp:='00';
            if (a<999) and (a>99) then temp:='0';
            str(a,start_pos);
            t2:=temp+start_pos;
            write_byte(chr(13));
            delay(1000);
            temp:=Dial_command+Prefix+t2+chr(13);
            write_byte(temp);
            gotoxy(48,5);
            textcolor(cyan);
            write('Dialing: ');textcolor(white);write(Prefix);
            textcolor(12);write('-');textcolor(white);write(t2);
            textcolor(cyan);
            gotoxy(48,7);
            write('Codes Found: ');
            textcolor(white);
            write(zz);
            textcolor(cyan);
            gotoxy(48,9);
            if zz>0 then write('Last found:',code_found[zz],'    ') else write('Last found: None');
            val(time,i,j);
            j:=i+timing_constant;
            repeat
                  if carrier then
                             begin
                                  zz:=zz+1;
                                  code_found[zz]:=prefix+'-'+t2;
                                  if print_stat then write(lst,code_found[zz]:10);
                                  hang_up;
                                  j:=i-26;
                                  Beep;
                             end;
                   val(time,i,k);
                   if keypressed then
                             begin
                                  write_byte(chr(13));
                                  read(kbd,ab);
                                  if ab=chr(45) then
                                              begin
                                                    all_codes;
                                                    menu;
                                              end;
                                  if ab=chr(50) then
                                     begin
                                          set_modem_parameters;
                                          normvideo;
                                          lowvideo;
                                          window(1,1,80,25);
                                          normvideo;
                                          lowvideo;
                                          window(6,9,73,19);
                                      end;
                                  if ab=chr(35) then
                                     begin
                                          help_wardial;
                                          normvideo;
                                          lowvideo;
                                          window(1,1,80,25);
                                          normvideo;
                                          lowvideo;
                                          window(6,9,73,19);
                                     end;
                                  if ab=chr(25) then toggle3_printer;
                             end;
            until i>j;
      a:=a+1;
      until dial_stop or (a>b);
      beep;delay(1000);beep;delay(1000);beep;delay(1000);
      write_byte(chr(13));
      if zz>0 then all_codes;
      menu;
end;

Procedure Write_Status;
var strg,strg2:sd;
begin
x2:=wherex;
y2:=wherey;
NormVideo;
SelectWindow(4);
gotoxy(1,1);
if parity=none then strg:='None' else strg:='Even';
textcolor(7);
write(' Terminal Mode  ',speed:4,'-',strg:4,'-',Dbits:1,'-',Stop_bits:1,'                         <Alt-Y> for Help');
NormVideo;
Lowvideo;
SelectWindow(5);
gotoxy(x2,y2);
end;

Procedure Quick_description;
var bl:integer;
begin
xcoord:=wherex;
ycoord:=wherey;
move(screen1,screen2,4000);
Normvideo;
lowvideo;
window(1,1,80,25);
normvideo;
textcolor(lightblue);
frame(1,1,50,20);
lowvideo;
window(2,2,49,19);
clrscr;
gotoxy(1,1);
textcolor(12);
writeln('               Brief Desciptions');
writeln;textcolor(7);
writeln('  Service Number:  When prompted for this,');
writeln('                   enter then number of a');
writeln('                   service.');
writeln('  Checksum number: Here you should enter');
writeln('                   the number that another');
writeln('                   computer can be reached.');
writeln('                   Wardial needs to detect a');
writeln('                   carrier.');
writeln('  Code length:     This is the length of the');
writeln('                   code being searched for.');
writeln('  First digit:     The first digit of the');
writeln('                   codes to be tested for.');
Writeln('  Timing constant: This is the delay time');
writeln('                   you wish to give to test');
textcolor(15);
write('  Press any key...');
repeat until keypressed;
read(kbd,ch);
textcolor(7);
writeln;
writeln('                   for carrier. (ie. 12 is');
writeln('                   good for sequential dialing');
writeln;
writeln('                   <Alt-H> gives a help menu in');
writeln('                   the service code option and');
writeln('                   the sequential dialer option.');
writeln;
writeln('                   Have fun. JRE.');
for bl:=1 to 7 do writeln;
gotoxy(1,17);
textcolor(white+blink);
writeln('              Hit any key...');
repeat until keypressed;
read(kbd,ch);
normvideo;
lowvideo;
window(1,1,80,25);
move(screen2,screen1,4000);
gotoxy(xcoord,ycoord);
end;



Procedure redial;
var number,t,number_to_dial:sd;
    i,j,k,l:integer;
    leave:boolean;
begin
xcoord:=wherex;
ycoord:=wherey;
move(screen1,screen2,4000);
Normvideo;
lowvideo;
window(1,1,80,25);
normvideo;
textcolor(3);
frame(40,5,65,15);
lowvideo;
window(41,6,64,14);
clrscr;
gotoxy(1,1);
textcolor(white);
writeln('   Redial Number');
textcolor(7);
writeln;
writeln(' Enter Number dial');
write(' > ');
readln(number);
if length(number)>0 then
        begin
        textcolor(white+blink);
        gotoxy(1,8);write(' ',chr(16));
        textcolor(7);write('      Dialing      ');
        textcolor(white+blink);write(chr(17));
        leave:=false;
        number_to_dial:=Dial_command+dial_type+number+chr(13);
        repeat
              if keypressed then leave:=true;
              val(time,j,k);
              i:=j+27;
              write_byte(Number_to_dial);
              repeat
                    if carrier then
                          begin
                               leave:=true;
                               i:=j-1;
                               beep;beep;beep;
                          end;
                    val(time,j,k);
                    if keypressed then leave:=true;
              until  (j>i) or leave;
        until leave;
        end;
        Normvideo;
        lowvideo;
        window(1,1,80,21);
        move(screen2,screen1,4000);
        set_up_recv_buffer;
        gotoxy(xcoord,ycoord);
        textcolor(maincolor);
end;

Procedure Terminal;
var leave, echo : boolean;
    a     : char;
    b     : smallstring;
    strg,prt:sd;
    tempbuf:string[81];
    bufpoint,i:integer;

begin
 Init_screen;
 Clrscr;
 textcolor(12);
 frame(wtab[4,1]-1,wtab[4,2]-1,wtab[4,3]+1,wtab[4,4]);
 lowvideo;
 selectWindow(4);
 gotoxy(1,1);
 maincolor:=11;
 if parity=none then strg:='None' else strg:='Even';
 textcolor(7);
 if printer then prt:='ON'else Prt:='OFF';
 write(' Terminal Mode  ',speed:4,'-',strg:4,'-',Dbits:1,'-',Stop_bits:1,'                        <Alt-Y> for Help');
 normvideo;
 lowvideo;
 textcolor(lightcyan);
 selectWindow(5);
 gotoxy(1,1);
 bufpoint:=1;
 init_port;
 tempbuf:='';
 writeln('Terminal ready. <Alt-Y> for Menu. <Alt-P> for Parameters.');
 beep;
 echo:=false;
 set_up_recv_buffer;
 leave := false;
 while not leave do
 begin
  if keypressed then
  begin
   repeat read(kbd,a) until a <> chr(27);
      i:=ord(a);
      case i of
          30:begin
                       Set_modem_parameters;
                       Selectwindow(5);
                  end;
          17:redial;
          19:rcv_asc;
          31:Send_asc;
          24:hang_up;
          21:help;
          16:Menu;
          27:break;
          25:begin
                       Set_parameters;
                       Write_status;
                       Textcolor(11);
                  end;
          end;
   if (a = chr(18)) and echo then
          begin
              echo:=false;
              beep;
          end
   else
   if (a = chr(18)) and not echo then
         begin
              writeln;Writeln('Echo On.');
              echo:=true;
              beep;
         end
  else
  if (a<chr(15)) or (a>chr(31)) then
       begin
          if echo then write(a);
          write_byte(a);
       end;
  end;
  if commpressed then write(cinkey);
 end;
end;


Procedure Menu;
var i:integer;
    cr:char;
begin
normvideo;
lowvideo;
window(1,1,80,25);
normvideo;
textcolor(12);
frame(9,4,70,17);
lowvideo;
remove_port;
window(10,5,69,16);
clrscr;
gotoxy(1,1);
textcolor(15);
Writeln('                       Wardial 1.2');
textcolor(7);
writeln('                            by   ');
Writeln('                       Jim Everingham ');
textcolor(15);
writeln('                           1984 ');
writeln;
textcolor(7);write('                <');textcolor(15);write('1');textcolor(7);writeln('> Service Code Finder');
textcolor(7);write('                <');textcolor(15);write('2');textcolor(7);writeln('> Sequential Dialer');
textcolor(7);write('                <');textcolor(15);write('3');textcolor(7);writeln('> Terminal Mode');
textcolor(7);write('                <');textcolor(15);write('4');textcolor(7);writeln('> Modem Parameters');
textcolor(7);write('                <');textcolor(15);write('5');textcolor(7);writeln('> Quick descriptions');
textcolor(7);write('                <');textcolor(15);write('6');textcolor(7);writeln('> Exit to System');
beep;
print_stat:=false;
Term_ready(false);
term_ready(true);
repeat
repeat
read(kbd,ch)
Until ch in ['1','2','3','4','5','6'];
      case ch of
          '1': wardial;
          '2': Sequential_dial;
          '3': begin
                  terminal;
                  set_up_recv_buffer;
             end;
          '4': Set_modem_parameters;
          '5': Quick_description;
          '6': begin
                  init_screen;
                  gotoxy(1,1);
                  write('Terminated');
                  gotoxy(1,25);
                  halt;
             end;
          end;
until cr='6';
normvideo;
ClrScr;
Window(1,1,80,25);
ClrScr;
end;

Procedure Opening_Screen;
begin
crtinit;
textcolor(white);
frame(4,4,76,21);
Lowvideo;
window(5,5,75,20);
textcolor(7);
ClrScr;
gotoxy(1,2);
writeln;Writeln('                             WARDIAL 1.2');
Writeln;
Writeln('       The Author of this Program takes no responsibility for the');
Writeln('       results of it''s uses.   It was  Developed for  experimental');
writeln('       purposes and to illistrate certain techniques.');
writeln('       Version 1.2 is a little more debugged and has a few extra');
writeln('       features. Hope you enjoy it.');
writeln('       Any inquiries can be sent to:');
writeln('                          Jim Everingham');
writeln('                          215 West Fairmount Ave.');
writeln('                          Apt #306 Fairmount Hills');
writeln('                          State College PA, 16801');
beep;
crtexit;
repeat until keypressed;
Normvideo;
crtexit;
lowvideo;
window(1,1,80,25);
normvideo;
clrscr;
end;


Procedure Wardial;
var test : boolean;
    a     : char;
    b     : smallstring;
    temp: sd;
    timing_constant,result: integer;

begin
lowvideo;
window(1,1,80,25);
clrscr;
textcolor(11);
writeln('Time is: ',time2);
writeln('Enter time to stop in format above ');
write('<Return> for none: ');
readln(Stop_time);
if length(stop_time)=7 then stop_time:='0'+stop_time;
normvideo;
clrscr;
beep;
gotoxy(7,12);textcolor(11);writeln('Trying Code:');
gotoxy(47,12);textcolor(11);writeln('Codes Found:');
textcolor(lightblue);
for ii:=1 to 3 do
       frame(wtab[ii,1]-1,wtab[ii,2]-1,wtab[ii,3]+1,wtab[ii,4]+1);
Lowvideo;
selectwindow(1);
gotoxy(1,1);
insline;
textcolor(15);
writeln('                       ',chr(205),chr(205),chr(16),'   Wardial 1.2   ',chr(17),chr(205),chr(205));
textcolor(3);writeln;
Write('   Enter Service Number: ');
textcolor(11);
readln(num);
textcolor(3);
service_number:=Dial_command+Dial_type+num+Pause_command;
write('   Enter Checksum Number: ');
textcolor(11);
readln(checksum_number);
textcolor(3);
write('   Enter timing Constant: ');
textcolor(11);
readln(temp);
val(temp,timing_constant,result);
if timing_constant <=5 then timing_constant:=27;
textcolor(3);
write('   Enter Code Length: ');
textcolor(11);
readln(temp);
val(temp,code_length,result);
textcolor(3);
write('   First number of code (1 digit): ');
textcolor(11);
readln(start_num);
if code_length<5 then code_length:=5;
textcolor(7);write('   <');
textcolor(15);write('Alt-H');
textcolor(7);write('> For Help menu');
if length(stop_time)=8 then begin
               textcolor(cyan);
               gotoxy(45,3);
               writeln('Program timed to stop ');
               gotoxy(45,4);
               write('at: ');
               textcolor(lightred+blink);
               write(stop_time);
               end;
normvideo;
 leave := false;
 zz:=0;
 while not leave do
 begin
  if keypressed then
  begin
  leave:=true;
  end
  else
  begin
       test:=false;
       get_code(code);
       if (length(stop_time)=8) and (time2 > stop_time) then
                         begin
                              leave:=true;
                              beep;delay(1000);beep;delay(1000);delay(1000);
                              if zz>0 then all_codes;
                              set_up_recv_buffer;
                              menu;
                          end;
       Send_code(Service_number,code,checksum_number);
       test_carrier(test,code,timing_constant);
       if test then
          begin
          remove_port;
          Menu;
          end;
       write_codes;
  end;
 end;
  if zz>0 then all_codes;
  beep;delay(1000);beep;delay(1000);beep;delay(1000);
  set_up_recv_buffer;
  menu;
end;

Procedure Make_data_file;
var a:string[20];
    infile:text;
    file_name:string[20];
begin
file_name:='WARDIAL.DTA';
assign(infile,file_name);
rewrite(infile);
textcolor(lightgreen);
read(kbd,ch);
writeln;Writeln('Creating  WARDIAL.DTA.');
write('Enter Baud      : ');
readln(a);
if (a='1200') or (a='300') or (a='9600') then writeln(infile,a)
else writeln(infile,'1200');
write('Enter Stop bits : ');
readln(a);
if (a<>'1') or (a<>'2') then writeln(infile,'1')
else writeln(infile,a);
write('Parity (E/N)    : ');
readln(a);
if upcase(copy(a,1,1))='E' then writeln(infile,'E') else writeln(infile,'N');
write('Enter Data Bits : ');
readln(a);
if (a='7') or (a='8') then writeln(infile,a) else writeln(infile,'8');
writeln;write('Are you Using a Hayes Or compatible Modem ? ');
readln(a);
if (copy(a,1,1)='Y') or (copy(a,1,1)='y') then begin
                           writeln;
                           writeln('Hayes Mode selected.');
                           writeln(infile,'ATD');
                           dial_type:='ATD';
                           writeln(infile,',,,,');
                           pause_command:=',,,,';
                           end
else
    begin
         writeln;
         writeln('Non-Hayes Mode Selected.');
         write('Enter Dial Command (ie. ATDT): ');
         readln(dial_command);
         writeln(infile,dial_command);
         write('Enter Pause Command          : ');
         readln(Pause_command);
         writeln(infile,pause_command);
         Dial_type:='';
    end;
delay(2000);
close(infile);
end;



Procedure Initial_Setup;
var a:string[40];
    ok: boolean;
    infile:text;
    file_name:string[20];
    result:integer;
begin
ok:=false;
ClrScr;
textcolor(11);
Writeln('Reading in data...');
file_name:='WARDIAL.DTA';
assign(infile,file_name);
{$I-} reset(infile) {$I+};
ok:=(ioresult=0);
if not ok then make_Data_file
else
begin
  readln(infile,a);
  val(a,speed,result);
  readln(infile,a);
  val(a,stop_bits,result);
  readln(infile,a);
  if a='E' then parity:=even else parity:=none;
  readln(infile,a);
  val(a,dbits,result);
  readln(infile,dial_command);
  readln(infile,pause_command);
  close(infile);
end;
ClrScr;
term_ready(true);
end;


var a     : char;
    b     : smallstring;

(* This is the Main Program *)

begin
     Dial_speed:='70';
     clrscr;
     maincolor:=11;
     xon:=chr(31);
     xoff:=chr(16);
     Print_stat:=false;
     Dial_type:='T';
     Speaker:='M1';
     Duplex:='F1';
     Command_echo:='E1';
     textcolor(lightcyan);
     Response_time:='6';
     Setup;
     Remove_port;
     Opening_screen;
     initial_setup;
     repeat
     menu;
     until keypressed;
end.